home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
AmigaUtil
/
DosUtil.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
3KB
|
141 lines
(***************************************************************************
$RCSfile: DosUtil.mod $
Description: Support for clients of dos.library
Created by: fjc (Frank Copeland)
$Revision: 3.9 $
$Author: fjc $
$Date: 1995/06/04 23:18:08 $
Copyright © 1994, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
***************************************************************************)
<* STANDARD- *>
MODULE DosUtil;
IMPORT e := Exec, d := Dos, s := Sets;
CONST (* Returned by ObjectExists() *)
no *= 0;
file *= 1;
dir *= 2;
other *= 3;
VAR
enableBreak *: BOOLEAN;
(*------------------------------------*)
PROCEDURE ObjectExists * ( path : ARRAY OF CHAR ) : INTEGER;
VAR
lock : d.FileLockPtr;
fib : d.FileInfoBlockPtr;
result : INTEGER;
<*$CopyArrays-*>
BEGIN (* ObjectExists *)
result := no;
lock := d.Lock (path, d.sharedLock);
IF lock # NIL THEN
fib := d.AllocDosObjectTags (d.fib, NIL);
IF fib # NIL THEN
IF d.Examine (lock, fib^) THEN
IF fib.dirEntryType < 0 THEN result := file
ELSIF fib.dirEntryType > 0 THEN result := dir
ELSE result := other
END
END;
d.FreeDosObject (d.fib, fib)
END;
d.UnLock (lock)
END;
RETURN result
END ObjectExists;
(*------------------------------------*)
PROCEDURE FileExists * (path : ARRAY OF CHAR) : BOOLEAN;
<*$CopyArrays-*>
BEGIN (* FileExists *)
RETURN (ObjectExists (path) = file)
END FileExists;
(*------------------------------------*)
PROCEDURE DirExists * (path : ARRAY OF CHAR) : BOOLEAN;
<*$CopyArrays-*>
BEGIN (* DirExists *)
RETURN (ObjectExists (path) = dir)
END DirExists;
(*------------------------------------*)
(*
Searches for "file" in the current directory first, followed by the
directories listed in "paths". If it is found the procedure returns TRUE
and the full pathname of the file is returned in "fullPath". If not, the
procedure returns FALSE and fullPath is set to "".
*)
PROCEDURE Search *
( VAR paths : ARRAY OF e.LSTRPTR;
file : ARRAY OF CHAR;
VAR fullPath : ARRAY OF CHAR)
: BOOLEAN;
VAR index : INTEGER; len : LONGINT; ch : CHAR;
<*$CopyArrays-*>
BEGIN (* Search *)
fullPath [0] := 0X; index := 0;
LOOP
IF ~d.AddPart (fullPath, file, LEN (fullPath)) THEN
RETURN FALSE
END;
IF FileExists (fullPath) THEN RETURN TRUE END;
IF paths [index] = NIL THEN
fullPath [0] := 0X; RETURN FALSE
ELSE
COPY (paths [index]^, fullPath); INC (index)
END
END
END Search;
PROCEDURE CheckBreak* ( breaks : s.SET32 ) : BOOLEAN;
VAR signals : s.SET32;
BEGIN (* CheckBreak *)
IF enableBreak THEN
signals := e.SetSignal ({}, {});
RETURN (signals * breaks) # {}
ELSE RETURN FALSE
END
END CheckBreak;
PROCEDURE HaltIfBreak * ( breaks : s.SET32 );
VAR signals : s.SET32;
BEGIN (* HaltIfBreak *)
IF enableBreak THEN
signals := e.SetSignal ({}, {});
IF (signals * breaks) # {} THEN
enableBreak := FALSE;
IF d.PutStr ("\n***BREAK -- User aborted\n") = 0 THEN END;
HALT (d.warn)
END
END
END HaltIfBreak;
BEGIN enableBreak := TRUE
END DosUtil.